home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / a / adressen / adressle / adressle.gfa (.txt) < prev    next >
Encoding:
GFA-BASIC Atari  |  1996-11-17  |  16.6 KB  |  812 lines
  1. ON BREAK CONT
  2. version$="v2.0"
  3. '
  4. ' --------------------------------------------
  5. ' globale Variablen:
  6. '
  7. ' n.ame$      25
  8. ' vorname$    25
  9. ' strasse$    25
  10. ' ort$        25
  11. ' tel$        15
  12. ' geb_tag$    10
  13. '
  14. ' titel$      enthält das »Titelbild«
  15. '
  16. ' ptr%        gesammte Anzahl von Adressen
  17. ' nr%         aktuell angezeigte Adresse
  18. ' b.alert|    Rückgabewert bei Alertboxen
  19. ' start%      Anfang des Speicherbereichs
  20. '
  21. ' aus!        Endeflag
  22. ' ____________________________________________
  23. '
  24. init             ! Allgemeine Vorbereitungen (z.B. Titel laden)
  25. '
  26. zeige_titel      ! Startbilschirm anzeigen
  27. zeige_seite(0)   ! Seite anzeigen
  28. laden            ! Als erstes 'was laden
  29. '
  30. '    **********************************************************************
  31. '    *                                                                    *
  32. '    *           's Adressbüchle   v2.0                                   *
  33. '    *                                                                    *
  34. '    *                     1988 by Joker Soft                             *
  35. '    *                                                                    *
  36. '    *             Johannes Schäfer, Am Rain 8, 7450 Hechingen            *
  37. '    *                                                                    *
  38. '    **********************************************************************
  39. '
  40. '
  41. ON MENU KEY GOSUB taste           ! Auf Tastendruck geht's ab nach "taste"
  42. '
  43. REPEAT                            ! ---- Hauptschleife ----
  44.   ON MENU                         ! Abfrage der Tastenbetätigung
  45.   IF MOUSEK                       ! Falls Mausklick ...
  46.     maus(MOUSEK)                  ! ... zu "maus", wo selbiger bearbeitet wird
  47.   ENDIF
  48. UNTIL aus!=TRUE                   ! ----      Ende     ----
  49. '
  50. VOID MFREE(start%)                ! Hier finden die Aufräumerein statt
  51. CLEAR
  52. RESERVE
  53. EDIT
  54. '
  55. '     *********************************************************************
  56. '     *                                                                   *
  57. '     *        Prozeduren                                                 *
  58. '     *                                                                   *
  59. '     *********************************************************************
  60. '
  61. '
  62. '
  63. PROCEDURE maus(k|)                                 ! Mausbehandlung
  64.   PAUSE 3                                          ! nötig, weil sonst "Pfeif.."
  65.   LOCAL x&,y&                                      ! Auslösende Koordinaten ...
  66.   x&=MENU(10)                                      ! ... x von hier,
  67.   y&=MENU(11)                                      ! ... y von da.
  68.   '
  69.   IF x&>550 AND x&<630 AND y&>350 AND y&<380       ! Falls rechts unten etc.
  70.     ende                                           ! dann halt 'raus !
  71.   ELSE IF y&>310 AND y&<340
  72.     IF x&>40 AND x&<180
  73.       laden
  74.     ELSE IF x&>380 AND x&<520
  75.       speichern
  76.     ELSE IF x&>210 AND x&<280
  77.       IF k|=1
  78.         minus
  79.       ELSE
  80.         buchst_minus
  81.       ENDIF
  82.     ELSE IF x&>280 AND x&<350
  83.       IF k|=1
  84.         plus
  85.       ELSE
  86.         buchst_plus
  87.       ENDIF
  88.     ENDIF
  89.   ELSE IF x&>20 AND x&<540 AND y&>270 AND y&<300
  90.     IF k|=1
  91.       buchstabe(x&)
  92.     ELSE
  93.       nr%=0
  94.       anzeigen(nr%)
  95.     ENDIF
  96.   ELSE IF x&>95 AND x&<480 AND y&>385 AND y&<399
  97.     zeige_titel
  98.   ELSE
  99.     ausgeben(x&,y&)
  100.   ENDIF
  101. RETURN
  102. '
  103. PROCEDURE taste
  104.   IF MENU(13)=4
  105.     contrl_taste
  106.   ELSE
  107.     norm_taste
  108.   ENDIF
  109.   REPEAT
  110.   UNTIL INKEY$=""
  111. RETURN
  112. '
  113. PROCEDURE norm_taste
  114.   LOCAL tl&,th&
  115.   tl&=MENU(14) AND &HFF
  116.   th&=(MENU(14) AND &HFF00)/&H100
  117.   '
  118.   IF tl&=43 OR th&=&H4D ! + ⇨
  119.     plus
  120.   ENDIF
  121.   IF tl&=45 OR th&=&H4B ! - ⇦
  122.     minus
  123.   ENDIF
  124.   IF th&=&H48 ! ⇧
  125.     buchst_plus
  126.   ENDIF
  127.   IF th&=&H50 ! ⇩
  128.     buchst_minus
  129.   ENDIF
  130.   IF th&=&H52 ! INSERT
  131.     eingeben
  132.   ENDIF
  133.   IF th&=&H47 ! HOME
  134.     nr%=0
  135.     anzeigen(nr%)
  136.   ENDIF
  137.   IF th&=&H61 ! UNDO
  138.     aendern
  139.   ENDIF
  140.   IF tl&>96 AND tl&<123 ! Kleinbuchstaben zu großen
  141.     SUB tl&,32
  142.   ENDIF
  143.   IF tl&>64 AND tl&<91  ! Großbuchstaben behandeln
  144.     IF abc%(tl&-65)<>-1
  145.       nr%=abc%(tl&-65)
  146.       anzeigen(nr%)
  147.     ENDIF
  148.   ENDIF
  149.   IF th&=&H1 ! ESC
  150.     zeige_titel
  151.   ENDIF
  152. RETURN
  153. '
  154. PROCEDURE contrl_taste
  155.   LOCAL tl&,th&
  156.   tl&=MENU(14) AND &HFF
  157.   th&=(MENU(14) AND &HFF00)/&H100
  158.   '
  159.   IF th&=&H12 OR th&=&H31 ! E oder N
  160.     eingeben
  161.   ENDIF
  162.   IF th&=&H28             ! Ä
  163.     aendern
  164.   ENDIF
  165.   IF th&=&H1F             ! S
  166.     speichern
  167.   ENDIF
  168.   IF th&=&H26             ! L
  169.     laden
  170.   ENDIF
  171.   IF th&=&H21             ! F
  172.     suchen
  173.   ENDIF
  174.   IF th&=&H2D             ! X
  175.     ende
  176.   ENDIF
  177.   IF th&=&H53             ! DELETE
  178.     ALERT 3,"Willst Du die Adresse|tatsächlich löschen ?",1,"JA|NEIN",b.alert|
  179.     IF b.alert|=1
  180.       loesche_inhalt
  181.       anzeigen(nr%)
  182.     ENDIF
  183.   ENDIF
  184.   IF th&=&H20 ! D
  185.     ausgeben(300,180)
  186.   ENDIF
  187. RETURN
  188. '
  189. '
  190. PROCEDURE suchen
  191.   LOCAL i%,ziel$
  192.   DEFMOUSE 3
  193.   IF ptr%>0
  194.     clr_seite
  195.     PRINT AT(15,6);"Suchstring: ";
  196.     FORM INPUT 25 AS such$
  197.     IF such$<>""
  198.       FOR i%=0 TO ptr%-1
  199.         ziel$=SPACE$(125)
  200.         BMOVE start%+i%*125,VARPTR(ziel$),125
  201.         IF INSTR(ziel$,such$)>0
  202.           nr%=i%
  203.           anzeigen(nr%)
  204.           REPEAT
  205.           UNTIL INKEY$<>"" OR MOUSEK
  206.         ENDIF
  207.         EXIT IF BIOS(11,-1)=4
  208.       NEXT i%
  209.     ENDIF
  210.     anzeigen(nr%)
  211.   ENDIF
  212.   DEFMOUSE 0
  213. RETURN
  214. '
  215. PROCEDURE buchst_plus
  216.   LOCAL i%,z&
  217.   IF nr%<ptr%-1
  218.     FOR i%=nr%+1 TO ptr%-1
  219.       z&=PEEK(start%+125*i%)-65
  220.       EXIT IF abc%(z&)<>-1 AND z&+65<>ASC(n.ame$)
  221.     NEXT i%
  222.     IF i%=ptr%
  223.       DEC i%
  224.     ENDIF
  225.     nr%=i%
  226.     anzeigen(nr%)
  227.   ENDIF
  228. RETURN
  229. '
  230. PROCEDURE buchst_minus
  231.   LOCAL i%,z&
  232.   IF nr%>0
  233.     FOR i%=nr%-1 DOWNTO 0
  234.       z&=PEEK(start%+125*i%)-65
  235.       EXIT IF abc%(z&)<>-1 AND z&+65<>ASC(n.ame$)
  236.     NEXT i%
  237.     IF i%=-1
  238.       INC i%
  239.     ENDIF
  240.     nr%=i%
  241.     anzeigen(nr%)
  242.   ENDIF
  243. RETURN
  244. '
  245. PROCEDURE ende
  246.   ALERT 2,"Wirklich Ende ??",1,"JA|Nein",b.alert|
  247.   IF b.alert|=1
  248.     aus!=TRUE
  249.   ENDIF
  250. RETURN
  251. '
  252. PROCEDURE speichern
  253.   LOCAL datei$
  254.   IF ptr%>0
  255.     datei$=@select$("Speichern","\*._le")
  256.     IF datei$<>""
  257.       BSAVE datei$,start%,ptr%*125
  258.     ENDIF
  259.   ENDIF
  260. RETURN
  261. '
  262. PROCEDURE laden
  263.   LOCAL datei$
  264.   datei$=@select$("Laden","\*._le")
  265.   IF datei$<>"" AND EXIST(datei$)
  266.     BLOAD datei$,start%
  267.     OPEN "i",#1,datei$
  268.     ptr%=LOF(#1)/125
  269.     CLOSE
  270.     anzeigen(nr%)
  271.     init_abc
  272.   ENDIF
  273. RETURN
  274. '
  275. PROCEDURE zeige_titel
  276.   GET 20,20,550,310,save$
  277.   PUT 20,20,titel$
  278.   PRINT AT(10,10);version$
  279.   DEFTEXT 1,16,0,6
  280.   TEXT 140,60,"geschrieben in GfA-BASIC v3.0"
  281.   REPEAT
  282.   UNTIL MOUSEK OR INKEY$<>""
  283.   PUT 20,20,save$
  284. RETURN
  285. '
  286. PROCEDURE plus
  287.   IF nr%<ptr%-1
  288.     INC nr%
  289.     anzeigen(nr%)
  290.   ENDIF
  291. RETURN
  292. '
  293. PROCEDURE minus
  294.   IF nr%>0
  295.     DEC nr%
  296.     anzeigen(nr%)
  297.   ENDIF
  298. RETURN
  299. '
  300. PROCEDURE eingeben
  301.   loesche
  302.   eingabe
  303.   IF n.ame$<>""
  304.     einfuegen
  305.   ENDIF
  306.   anzeigen(nr%)
  307. RETURN
  308. '
  309. PROCEDURE aendern
  310.   IF ptr%>0
  311.     hole_inhalt(nr%)
  312.     eingabe
  313.     loesche_inhalt
  314.     einfuegen
  315.     anzeigen(nr%)
  316.     init_abc
  317.   ENDIF
  318. RETURN
  319. '
  320. PROCEDURE buchstabe(x&)
  321.   DIV x&,20
  322.   DEC x&
  323.   IF abc%(x&)<>-1 AND abc%(x&)>nr%
  324.     nr%=abc%(x&)
  325.     anzeigen(abc%(x&))
  326.   ENDIF
  327. RETURN
  328. '
  329. PROCEDURE ausgeben(x&,y&)
  330.   IF k|=2
  331.     SELECT @flip(x&,y&,men_ausgeben$())
  332.     CASE 1
  333.       aus_1x(nr%,"LST:")
  334.     CASE 2
  335.       datei$=@select$("> Datei","\*.TXT")
  336.       aus_1x(nr%,datei$)
  337.     CASE 3
  338.       aus_kompl("LST:")
  339.     CASE 4
  340.       datei$=@select$("alles > Datei","\*.TXT")
  341.       aus_kompl(datei$)
  342.     ENDSELECT
  343.   ELSE
  344.     SELECT @flip(x&,y&,men_eintrag$())
  345.     CASE 1
  346.       plus
  347.     CASE 2
  348.       minus
  349.     CASE 3
  350.       eingeben
  351.     CASE 4
  352.       aendern
  353.     CASE 5
  354.       ALERT 3,"Willst Du die Adresse|tatsächlich löschen ?",1,"JA|NEIN",b.alert|
  355.       IF b.alert|=1
  356.         loesche_inhalt
  357.         anzeigen(nr%)
  358.       ENDIF
  359.     CASE 6
  360.       suchen
  361.     ENDSELECT
  362.   ENDIF
  363. RETURN
  364. '
  365. PROCEDURE loesche_inhalt
  366.   IF ptr%>0
  367.     IF nr%<ptr%-1
  368.       BMOVE start%+nr%*125+125,start%+nr%*125,ptr%*125-125-nr%*125
  369.     ENDIF
  370.     DEC ptr%
  371.     IF nr%=ptr%
  372.       DEC nr%
  373.     ENDIF
  374.     init_abc
  375.   ENDIF
  376. RETURN
  377. '
  378. '
  379. PROCEDURE aus_1x(nr%,nach$)
  380.   DEFMOUSE 2
  381.   IF ptr%>0
  382.     IF (OUT?(0) AND nach$="LST:") OR (nach$<>"" AND nach$<>"LST:")
  383.       IF EXIST(nach$) AND nach$<>"LST:"
  384.         OPEN "u",#1,nach$
  385.       ELSE
  386.         OPEN "o",#1,nach$
  387.       ENDIF
  388.       s$="Soll die Telefonnr. und|das Geburtsdatum|mitgedruckt werden ?"
  389.       ALERT 2,s$,1,"Nein|Nur Tel.|Beides",b.alert|
  390.       hole_inhalt(nr%)
  391.       PRINT #1,n.ame$;", ";vorname$
  392.       PRINT #1,strasse$
  393.       IF nach$="LST:"
  394.         PRINT #1,CHR$(27);CHR$(&H2D);CHR$(1);
  395.       ENDIF
  396.       PRINT #1,ort$
  397.       IF nach$="LST:"
  398.         PRINT #1,CHR$(27);CHR$(&H2D);CHR$(0);
  399.       ENDIF
  400.       IF b.alert|<>1
  401.         PRINT #1,tel$
  402.         IF b.alert|=3
  403.           PRINT #1,geb_tag$
  404.         ENDIF
  405.       ENDIF
  406.       PRINT #1
  407.       CLOSE
  408.     ELSE
  409.       IF nach$<>""
  410.         ALERT 3," Erst Drucker anschalten !",1,"Ach so !",b.alert|
  411.       ENDIF
  412.     ENDIF
  413.   ENDIF
  414.   DEFMOUSE 0
  415. RETURN
  416. '
  417. PROCEDURE aus_kompl(nach$)
  418.   LOCAL i%,l&,ll&
  419.   DEFMOUSE 2
  420.   IF ptr%>0
  421.     IF (OUT?(0) AND nach$="LST:") OR (nach$<>"" AND nach$<>"LST:")
  422.       OPEN "o",#1,nach$
  423.       FOR i%=0 TO ptr%-1
  424.         hole_inhalt(i%)
  425.         l&=LEN(n.ame$)+LEN(vorname$)+1
  426.         IF l&>ll&
  427.           ll&=l&
  428.         ENDIF
  429.       NEXT i%
  430.       ADD ll&,2
  431.       FOR i%=0 TO ptr%-1
  432.         hole_inhalt(i%)
  433.         voller_name$=SPACE$(ll&)
  434.         LSET voller_name$=n.ame$+" "+vorname$+", "
  435.         PRINT #1,voller_name$;strasse$;","
  436.         PRINT #1,SPC(LEN(voller_name$));ort$;", ";tel$;", ";geb_tag$
  437.       NEXT i%
  438.       CLOSE
  439.     ELSE
  440.       IF nach$<>""
  441.         ALERT 3," Erst Drucker anschalten !",1,"Ach so !",b.alert|
  442.       ENDIF
  443.     ENDIF
  444.   ENDIF
  445.   DEFMOUSE 0
  446. RETURN
  447. '
  448. PROCEDURE anzeigen(nr%)
  449.   clr_seite
  450.   '
  451.   IF ptr%>0
  452.     hole_inhalt(nr%)
  453.     zeige_seite(ASC(UPPER$(LEFT$(n.ame$)))-65)
  454.     PRINT AT(14,5);n.ame$;","'vorname$
  455.     PRINT AT(15,7);strasse$
  456.     PRINT AT(15,9);ort$
  457.     PRINT AT(15,10);STRING$(LEN(ort$),255)
  458.     PRINT AT(15,12);tel$
  459.     PRINT AT(55,16);SPACE$(10)
  460.     PRINT AT(15,14);geb_tag$
  461.     PRINT AT(55,16);"Seite"'nr%+1
  462.   ENDIF
  463. RETURN
  464. '
  465. PROCEDURE schreibe_inhalt(nr%,inh$)
  466.   IF inh$<>SPACE$(125)
  467.     BMOVE VARPTR(inh$),start%+125*nr%,125
  468.     init_abc
  469.   ENDIF
  470. RETURN
  471. '
  472. DEFFN erweitern$(s$,l&)=s$+SPACE$(l&-LEN(s$))
  473. '
  474. PROCEDURE clr_seite
  475.   DEFFILL 0
  476.   PBOX 100,50,535,265
  477. RETURN
  478. '
  479. PROCEDURE eingabe
  480.   zeige_seite(0)
  481.   clr_seite
  482.   BOX 100,64,500,240
  483.   BOX 102,66,498,238
  484.   WHILE INKEY$<>""
  485.   WEND
  486.   REPEAT
  487.     PRINT AT(23,6);"Name : ";
  488.     FORM INPUT 25 AS n.ame$
  489.     zeige_seite(ASC(UPPER$(LEFT$(n.ame$)))-65)
  490.     PRINT AT(20,7);"Vorname : ";
  491.     FORM INPUT 25 AS vorname$
  492.     PRINT AT(21,9);"Straße : ";
  493.     FORM INPUT 25 AS strasse$
  494.     PRINT AT(15,10);"Plz. und Ort : ";
  495.     FORM INPUT 25 AS ort$
  496.     PRINT AT(20,12);"Telefon : ";
  497.     FORM INPUT 15 AS tel$
  498.     PRINT AT(17,14);"Geburtstag : ";
  499.     FORM INPUT 10 AS geb_tag$
  500.   UNTIL BIOS(11,-1)<>4
  501.   clr_seite
  502. RETURN
  503. '
  504. PROCEDURE einfuegen
  505.   LOCAL i%,vergl$,inhalt$
  506.   i%=0
  507.   IF ptr%>0
  508.     '
  509.     FOR i%=0 TO ptr%-1                             ! Suchen
  510.       vergl$=SPACE$(25)                            ! evt. durch andere Such-
  511.       BMOVE start%+i%*125,VARPTR(vergl$),25        ! methode zu ersetzen.
  512.       EXIT IF UPPER$(n.ame$)<UPPER$(vergl$)
  513.     NEXT i%
  514.     '
  515.     IF i%<ptr%
  516.       BMOVE start%+125*i%,start%+125*i%+125,125*(ptr%-i%)
  517.     ENDIF
  518.   ENDIF
  519.   packe(inhalt$)
  520.   IF inhalt$<>SPACE$(125)
  521.     schreibe_inhalt(i%,inhalt$)
  522.     INC ptr%
  523.     init_abc
  524.   ENDIF
  525. RETURN
  526. '
  527. PROCEDURE loesche
  528.   CLR n.ame$,vorname$,strasse$,ort$,tel$,geb_tag$
  529. RETURN
  530. '
  531. PROCEDURE hole_inhalt(nr%)
  532.   LOCAL ziel$
  533.   IF ptr%>0
  534.     ziel$=SPACE$(125)
  535.     BMOVE start%+nr%*125,VARPTR(ziel$),125
  536.     '
  537.     n.ame$=TRIM$(LEFT$(ziel$,25))
  538.     vorname$=TRIM$(MID$(ziel$,26,25))
  539.     strasse$=TRIM$(MID$(ziel$,51,25))
  540.     ort$=TRIM$(MID$(ziel$,76,25))
  541.     tel$=TRIM$(MID$(ziel$,101,15))
  542.     geb_tag$=TRIM$(MID$(ziel$,116,10))
  543.   ENDIF
  544. RETURN
  545. '
  546. PROCEDURE zeige_seite(nr%)
  547.   LOCAL i%
  548.   DEFTEXT 1,0,0,13
  549.   DEFFILL 0
  550.   PBOX 23,270,539,299
  551.   '
  552.   IF nr%=77
  553.     nr%=0
  554.   ENDIF
  555.   IF nr%=88
  556.     nr%=14
  557.   ENDIF
  558.   IF nr%=89
  559.     nr%=20
  560.   ENDIF
  561.   IF nr%>=0 AND nr%<26
  562.     TEXT nr%*20+27,290,CHR$(nr%+65)
  563.     IF nr%<25
  564.       FOR i%=nr%+1 TO 25
  565.         TEXT i%*20+27,290,CHR$(i%+65)
  566.         BOX i%*20+20,270,i%*20+40,300
  567.       NEXT i%
  568.       BOX (nr%+1)*20+21,271,(i%-1)*20+40,300
  569.     ENDIF
  570.     TEXT 62,85,CHR$(nr%+65)
  571.   ENDIF
  572. RETURN
  573. '
  574. PROCEDURE packe(VAR ziel$)
  575.   ziel$=@erweitern$(n.ame$,25)
  576.   ziel$=ziel$+@erweitern$(vorname$,25)
  577.   ziel$=ziel$+@erweitern$(strasse$,25)
  578.   ziel$=ziel$+@erweitern$(ort$,25)
  579.   ziel$=ziel$+@erweitern$(tel$,15)
  580.   ziel$=ziel$+@erweitern$(geb_tag$,10)
  581. RETURN
  582. '
  583. PROCEDURE init_abc
  584.   LOCAL i%,z%
  585.   FOR i%=ptr%-1 DOWNTO 0
  586.     z%=PEEK(start%+125*i%)-65
  587.     IF z%>=0 AND z%<26
  588.       abc%(z%)=i%
  589.     ENDIF
  590.   NEXT i%
  591. RETURN
  592. '
  593. FUNCTION flip(x&,y&,VAR men$())
  594.   LOCAL anzahl&,breite&,x_pos&,y_pos&,m_keys&,akt&,last&
  595.   anzahl&=DIM?(men$())-1
  596.   breite&=LEN(men$(0))
  597.   '
  598.   DIV x&,8
  599.   DIV y&,16
  600.   IF x&<2
  601.     x&=2
  602.   ENDIF
  603.   IF y&<3
  604.     y&=3
  605.   ENDIF
  606.   IF 79-x&<breite&
  607.     x&=79-breite&
  608.   ENDIF
  609.   IF 24-y&<anzahl&
  610.     y&=24-anzahl&
  611.   ENDIF
  612.   akt&=0
  613.   last&=0
  614.   x_min&=(x&+1)*8-16
  615.   x_max&=(x&+breite&+1)*8-16
  616.   y_min&=y&*16-1
  617.   y_max&=(y&+anzahl&)*16-1
  618.   GET x_min&-5,y_min&-5-16,x_max&+5,y_max&+5,screen$
  619.   rahmen(x&,y&-1,x&+breite&,y&+anzahl&)
  620.   fuellen
  621.   REPEAT
  622.     MOUSE x_pos&,y_pos&,m_keys&
  623.     last&=akt&
  624.     IF x_pos&>=x_min& AND x_pos&<=x_max& AND y_pos&>=y_min& AND y_pos&<=y_max&
  625.       akt&=(y_pos&-2-y_min&) DIV 16+1
  626.     ELSE
  627.       akt&=0
  628.     ENDIF
  629.     IF last&<>akt&
  630.       update
  631.     ENDIF
  632.   UNTIL m_keys&=0
  633.   PUT x_min&-5,y_min&-5-16,screen$
  634.   RETURN akt&
  635. ENDFUNC
  636. '
  637. PROCEDURE fuellen
  638.   LOCAL i&
  639.   HIDEM
  640.   FOR i&=1 TO anzahl&
  641.     PRINT AT(x&,y&+i&);men$(i&);
  642.   NEXT i&
  643.   SHOWM
  644. RETURN
  645. '
  646. PROCEDURE update
  647.   HIDEM
  648.   IF last&<>0
  649.     PRINT AT(x&,y&+last&);men$(last&)
  650.   ENDIF
  651.   IF akt&<>0
  652.     PRINT AT(x&,y&+akt&);CHR$(27);"p";men$(akt&);CHR$(27);"q";
  653.   ENDIF
  654.   SHOWM
  655. RETURN
  656. '
  657. PROCEDURE rahmen(x0&,y0&,x1&,y1&)
  658.   HIDEM
  659.   ADD x1&,2
  660.   DEC x0&
  661.   x0&=SHL(x0&,3)
  662.   SUB x0&,5
  663.   DEC x1&
  664.   x1&=SHL(x1&,3)
  665.   SUB x1&,12
  666.   DEC y0&
  667.   y0&=SHL(y0&,4)
  668.   ADD y0&,11
  669.   DEC y1&
  670.   y1&=SHL(y1&,4)
  671.   ADD y1&,20
  672.   DEFFILL 0
  673.   PBOX x0&,y0&,x1&,y1&
  674.   BOX x0&,y0&,x1&,y1&
  675.   BOX x0&+2,y0&+2,x1&-2,y1&-2
  676.   BOX x0&+3,y0&+3,x1&-3,y1&-3
  677.   DEFTEXT 1,0,0,6
  678.   TEXT x0&+4,y0&+17,men$(0)
  679. RETURN
  680. '
  681. FUNCTION select$(txt$,pfad$)
  682.   LOCAL save$,s$
  683.   GET 150,15,485,55,save$
  684.   DEFFILL 0
  685.   PBOX 157,20,482,54
  686.   BOX 157,20,482,54
  687.   BOX 160,23,479,51
  688.   BOX 161,24,478,50
  689.   DEFTEXT 1,5,0,13
  690.   TEXT 250,44,150,txt$
  691.   FILESELECT pfad$,"",s$
  692.   PUT 150,15,save$
  693.   IF LEN(s$)<4
  694.     s$=""
  695.   ENDIF
  696.   RETURN s$
  697. ENDFUNC
  698. '
  699. ' ******************** Initialisierungsprozeduren ***************************
  700. '
  701. PROCEDURE init
  702.   LOCAL vorn#,hinten#,s_tel$,i|
  703.   '
  704.   RESERVE 100000           ! Basic-Speicher verkleinern
  705.   start%=MALLOC(100000)    ! und sonstigen Speicher vom Gemdos holen
  706.   '
  707.   titel$=SPACE$(18684)                       ! Platz für's Titelbild
  708.   BLOAD "\adressle\titel.obj",VARPTR(titel$) ! und laden ...
  709.   '
  710.   RESTORE s_tel                                    ! Sprite-Daten
  711.   s_tel$=MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(1)   ! für's Telefon
  712.   FOR i%=1 TO 16
  713.     READ vorn#,hinten#
  714.     LET s_tel$=s_tel$+MKI$(hinten#)+MKI$(vorn#)
  715.   NEXT i%
  716.   '
  717.   DIM men_ausgeben$(4)     ! Pop-Up-Menü einlesen, damit wir's parat haben
  718.   RESTORE ausgeben         ! (über die linke Maustaste erreichbar)
  719.   FOR i|=0 TO 4
  720.     READ men_ausgeben$(i|)
  721.   NEXT i|
  722.   '
  723.   DIM men_eintrag$(6)      ! ebenso das zweite, über die rechte Maustaste
  724.   RESTORE eintrag          ! erreichbare Menü
  725.   FOR i|=0 TO 6
  726.     READ men_eintrag$(i|)
  727.   NEXT i|
  728.   '
  729.   DIM abc%(25)          ! das Array für die vorhandenen Buchstaben
  730.   ARRAYFILL abc%(),-1   ! zuerst mit -1 für nirgends "vorhanden" füllen
  731.   '
  732.   ptr%=0
  733.   nr%=0
  734.   '
  735.   zeige_schirm
  736. RETURN
  737. '
  738. '
  739. PROCEDURE zeige_schirm
  740.   LOCAL i&
  741.   DEFFILL 1,2,4
  742.   BOUNDARY 0
  743.   PBOX 0,0,640,400
  744.   '
  745.   DEFFILL 0
  746.   PBOX 20,20,540,300
  747.   BOX 20,20,540,300
  748.   BOX 23,23,537,267
  749.   DEFLINE ,3,,2
  750.   FOR i&=30 TO 540 STEP 25
  751.     ELLIPSE i&,25,8,15,200,2700
  752.   NEXT i&
  753.   DEFLINE ,1
  754.   '
  755.   BOX 40,64,90,94
  756.   LINE 40,64,90,94
  757.   LINE 40,94,90,64
  758.   SPRITE s_tel$,74,174
  759.   DEFTEXT 1,16
  760.   TEXT 78,222,"*"
  761.   '
  762.   DEFFILL 0
  763.   DEFTEXT 1,17,0,13
  764.   PBOX 210,310,350,340
  765.   BOX 210,310,350,340
  766.   BOX 211,311,349,339
  767.   BOX 211,311,280,339
  768.   TEXT 230,330,100,"- +"
  769.   '
  770.   DEFTEXT 1,5,0,13
  771.   PBOX 40,310,180,340
  772.   BOX 40,310,180,340
  773.   BOX 41,311,179,339
  774.   TEXT 70,330,70,"laden"
  775.   PBOX 380,310,520,340
  776.   BOX 380,310,520,340
  777.   BOX 381,311,519,339
  778.   TEXT 400,330,100,"speichern"
  779.   '
  780.   DEFTEXT 1,1,0,13
  781.   PBOX 550,350,630,380
  782.   BOX 550,350,630,380
  783.   BOX 551,351,629,379
  784.   BOX 553,353,627,377
  785.   TEXT 562,370,"E N D E"
  786.   '
  787.   DEFTEXT 1,0,0,6
  788.   PBOX 95,385,480,399
  789.   BOX 95,385,480,399
  790.   TEXT 100,395,"» 's Adressbüchle «    1988 by Johannes Schäfer"
  791. RETURN
  792. '
  793. '
  794. s_tel:
  795. DATA 0,0,0,0,0,0,0,0,32766,0,32769,0,34785,0,35889,0
  796. DATA 29742,0,1056,0,2448,0,4680,0,4680,0,4492,0,4106,0,4081,0
  797. '
  798. ausgeben:
  799. DATA "     AUSGEBEN     "
  800. DATA " > Drucker        "
  801. DATA " > Datei          "
  802. DATA " alles > Drucker  "
  803. DATA " alles > Datei    "
  804. eintrag:
  805. DATA "  EINTRAG  "
  806. DATA " vor       "
  807. DATA " zurück    "
  808. DATA " neu       "
  809. DATA " ändern    "
  810. DATA " löschen   "
  811. DATA " suchen    "
  812.